COVID-19
Philip Ridgill
16/11/2020
World data
New cases by continent
covid_100_continent %>%
filter(date > as.Date("20/02/2020", format = "%d/%m/%Y")) %>%
ggplot(aes(x = date, y = new_cases_7, fill = continent)) +
geom_col(col = "grey", size = 0.1) +
scale_x_date(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Daily cases", y = "New cases") +
theme_light() +
theme(axis.title.x = element_blank())
Share
covid_100_continent %>%
filter(date > as.Date("20/02/2020", format = "%d/%m/%Y")) %>%
ggplot(aes(x = date, y = new_cases_7, fill = continent)) +
geom_col(position = "fill", col = "grey") +
scale_x_date(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), labels = percent_format()) +
theme_light() +
theme(axis.title.x = element_blank()) +
labs(title = "Share of new cases by continent", y = "Ney deaths (%)")
covid_100_continent %>%
filter(date > as.Date("20/02/2020", format = "%d/%m/%Y")) %>%
ggplot(aes(x = date, y = new_cases_7, fill = continent)) +
geom_col() +
scale_x_date(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "New cases by continent", y = "New cases") +
theme_light() +
theme(axis.title.x = element_blank()) +
facet_wrap(~ continent)
New deaths by continent
covid_10_deaths_continent %>%
filter(date > as.Date("20/02/2020", format = "%d/%m/%Y")) %>%
ggplot(aes(x = date, y = new_deaths_7, fill = continent)) +
geom_col(col = "grey") +
scale_x_date(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0)) +
theme_light() +
theme(axis.title.x = element_blank()) +
labs(title = "Daily deaths", y = "New deaths")
Share
covid_10_deaths_continent %>%
filter(date > as.Date("20/02/2020", format = "%d/%m/%Y")) %>%
ggplot(aes(x = date, y = new_deaths_7, fill = continent)) +
geom_col(position = "fill", col = "grey") +
scale_x_date(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0), labels = percent_format()) +
theme_light() +
theme(axis.title.x = element_blank()) +
labs(title = "Share of new deaths by continent", y = "Ney deaths (%)")
covid_10_deaths_continent %>%
filter(date > as.Date("20/02/2020", format = "%d/%m/%Y")) %>%
ggplot(aes(x = date, y = new_deaths_7, fill = continent)) +
geom_col() +
scale_x_date(expand = c(0,0)) +
scale_y_continuous(expand = c(0,0)) +
theme_light() +
theme(axis.title.x = element_blank()) +
labs(title = "New deaths by continent", y = "New deaths") +
facet_wrap(~ continent)
Map
New cases per million (7 day average): Today
breaks_new_cases <- c(0, 5, 10, 20, 30, 50, 100, 200, 300, 500, 750, 1000, Inf)
pallete_pretty <- c("#E0F3F8", "#FFFFA6", "#FDBE81", "#F68A69", "#DD4234", "#AF0D28", "#780510")
world_new_cases <- tm_shape(world_map_today, projection = "robin") +
tm_polygons(col = "new_cases_7_pop", breaks = breaks_new_cases, palette = pallete_pretty, title = "", colorNA = "grey95") +
tm_layout(frame = FALSE, title = "") +
tm_style("col_blind") +
tm_legend(hist.width = 0.25)
# "#74ADD1", "#E0F3F8", "#FFFFA6", "#FDBE81", "#F68A69", "#DD4234", "#AF0D28", "#780510"
# "#7030A0", "#E0F3F8", "#F8FAA3", "#F6B97E", "#EF8566", "#D8544F", "#B02E4E"
#"#604A7B", "#7030A0", "#6600CC", "#5600BB", "#5D64C4", "#89B8D7","#F8FAA3","#F6B97E","#EF8566","#D8544F", "#B02E4E"
tmap_save(world_new_cases, filename = "world_new_cases.jpg", width = 2500, height = 1100)
knitr::include_graphics(path="world_new_cases.jpg")
Day by Day animation
breaks_new_cases <- c(0, 5, 10, 20, 30, 50, 100, 200, 300, 500, 750, 1000, Inf)
world_anim_cases <- tm_shape(world_map_all, projection = "robin") +
tm_polygons(col = "new_cases_7_pop", breaks = breaks_new_cases, palette = pallete_pretty, title = "New cases per million (7 day average)", colorNA = "grey95") +
tm_layout(frame = FALSE, title = "", title.position = c("center", "top")) +
tm_facets(along = "date", free.coords = FALSE) +
tm_style("col_blind")
#world_anim_cases
tmap_animation(world_anim_cases, filename = "world_new_cases.gif", width = 1500,
height = 660, dpi = 72, delay = 20, loop = TRUE,
restart.delay = 200)
Weekly change in new cases
breaks_WoW <- c(-1, -0.5, -0.25, -0.1, 0, 0.1, 0.25, 0.5, 1, 2, Inf)
world_WoW_new_cases <- tm_shape(world_map_today, projection = "robin") +
tm_polygons(col = "WoW_new_cases_7", breaks = breaks_WoW, palette = "-PiYG", title = "", colorNA = "grey95") +
tm_layout(frame = FALSE, title = "", title.position = c("center", "top")) +
tm_style("col_blind")
tmap_save(world_WoW_new_cases, filename = "world_WoW_new_cases.jpg", width = 2500, height = 1100)
knitr::include_graphics(path="world_WoW_new_cases.jpg")
Day by day animation
breaks_WoW <- c(-1, -0.5, -0.25, -0.1, 0, 0.1, 0.25, 0.5, 1, 2, Inf)
world_anim_WoW_cases <- tm_shape(world_map_all, projection = "robin") +
tm_polygons(col = "WoW_new_cases_7", breaks = breaks_WoW, palette = "-PiYG", title = "Weekly change in average new cases") +
tm_layout(frame = FALSE, title = "Weekly change in average new cases", title.position = c("center", "top")) +
tm_facets(along = "date", free.coords = FALSE) +
tm_style("col_blind")
#world_anim_WoW_cases
tmap_animation(world_anim_WoW_cases, filename = "world_WoW_new_cases.gif", width = 1500,
height = 660, dpi = 72, delay = 20, loop = TRUE,
restart.delay = 200)
New deaths per million (7 day average): Today
breaks_new_deaths <- c(0, 0.5, 1, 1.5, 2, 3, 5, 10, 20, 30, Inf)
world_new_deaths <- tm_shape(world_map_today, projection = "robin") +
tm_polygons(col = "new_deaths_7_pop", breaks = breaks_new_deaths, palette = pallete_pretty, title = "", colorNA = "grey95") +
tm_layout(frame = FALSE, title = "") +
tm_style("col_blind")
tmap_save(world_new_deaths, filename = "world_new_deaths.jpg", width = 2500, height = 1100)
knitr::include_graphics(path="world_new_deaths.jpg")
Day by Day animation
breaks_new_deaths <- c(0, 0.5, 1, 1.5, 2, 3, 5, 10, 20, 30, Inf)
world_anim_deaths <- tm_shape(world_map_all, projection = "robin") +
tm_polygons(col = "new_deaths_7_pop", breaks = breaks_new_deaths, palette = pallete_pretty, title = "New deaths per million (7 day average)", colorNA = "grey95") +
tm_layout(frame = FALSE, title = "", title.position = c("center", "top")) +
tm_facets(along = "date", free.coords = FALSE) +
tm_style("col_blind")
#world_anim_deaths
tmap_animation(world_anim_deaths, filename = "world_new_deaths.gif", width = 1500,
height = 660, dpi = 72, delay = 20, loop = TRUE,
restart.delay = 200)
Weekly change in new deaths
breaks_WoW <- c(-1, -0.5, -0.25, -0.1, 0, 0.1, 0.25, 0.5, 1, 2, Inf)
world_WoW_new_deaths <- tm_shape(world_map_today, projection = "robin") +
tm_polygons(col = "WoW_new_deaths_7", breaks = breaks_WoW, palette = "-PiYG", title = "", colorNA = "grey95") +
tm_layout(frame = FALSE, title = "", title.position = c("center", "top")) +
tm_style("col_blind")
tmap_save(world_WoW_new_deaths, filename = "world_WoW_new_deaths.jpg", width = 2500, height = 1100)
knitr::include_graphics(path="world_WoW_new_deaths.jpg")
Day by day animation
breaks_WoW <- c(-1, -0.5, -0.25, -0.1, 0, 0.1, 0.25, 0.5, 1, 2, Inf)
world_anim_WoW_deaths <- tm_shape(world_map_all, projection = "robin") +
tm_polygons(col = "WoW_new_deaths_7", breaks = breaks_WoW, palette = "-PiYG", title = "Weekly change in average new deaths") +
tm_layout(frame = FALSE, title = "", title.position = c("center", "top")) +
tm_facets(along = "date", free.coords = FALSE) +
tm_style("col_blind")
#world_anim_WoW_deaths
tmap_animation(world_anim_WoW_deaths, filename = "world_WoW_new_deaths.gif", width = 1500,
height = 660, dpi = 72, delay = 20, loop = TRUE,
restart.delay = 200)
Treemap
Cumulative
treemap(covid %>% filter(date == as.Date(date_today, format = "%d/%m/%Y")),
index=c("continent","location"),
vSize="total_cases",
type="index",
palette = "Set2",
bg.labels=c("grey"),
align.labels=list(c("center", "center"),
c("left", "center")),
title = "total cases by continent and country"
) 
treemap(covid %>% filter(date == as.Date(date_today, format = "%d/%m/%Y")),
index=c("continent","location"),
vSize="total_deaths",
type="index",
palette = "Set2",
bg.labels=c("grey"),
align.labels=list(c("center", "center"),
c("left", "center")),
title = "total deaths by continent and country"
) 
Last Week
treemap(covid %>% filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>% filter(new_cases_7 > 0.00001),
index=c("continent","location"),
vSize="new_cases_7",
type="index",
palette = "Set2",
bg.labels=c("grey"),
align.labels=list(c("center", "center"),
c("left", "center")),
title = "New cases by continent and country"
) 
treemap(covid %>% filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>% filter(new_deaths_7 > 0.00001),
index=c("continent","location"),
vSize="new_deaths_7",
type="index",
palette = "Set2",
bg.labels=c("grey"),
align.labels=list(c("center", "center"),
c("left", "center")),
title = "New deaths by continent and country"
) 
Change in 7 day rolling average
Cases
# covid %>%
# filter(location != "World") %>%
# filter(new_cases_7 > 200) %>%
# filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
# mutate(location = fct_reorder(location, -new_cases_7_pop)) %>%
# ggplot(aes(x = location, y = WoW_new_cases_7, fill = continent)) +
# geom_col(position = "dodge", col = "black") +
# scale_y_continuous(expand = c(0,0), labels = percent_format(), breaks = seq(-1,3,0.5), limits = c(-1, 2)) +
# geom_hline(yintercept = 0, linetype = "dashed") +
# theme_light() +
# theme(axis.title.x = element_blank(), panel.grid.minor = element_blank()) +
# theme(axis.text.x = element_text(angle = 90, size = 8, vjust = 0.5)) +
# labs(title = "New Cases growth", subtitle = "ordered by 7 day rolling average of new cases (> 200) per million ", y = "Week on Week change of average new cases")new_cases_per_pop <- covid %>%
filter(location != "World") %>%
filter(new_cases_7 > 100) %>%
filter(new_cases_7_pop > 50) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, new_cases_7_pop)) %>%
ggplot(aes(x = location, y = new_cases_7_pop, fill = continent)) +
geom_col(position = "dodge", col = "black") +
scale_y_continuous(expand = c(0,0)) +
geom_hline(yintercept = 0, linetype = "dashed") +
theme_light() +
theme(axis.title.y = element_blank(), panel.grid.minor = element_blank()) +
theme(axis.text.y = element_text(size = 7)) +
coord_flip() +
labs(title = "New Cases per million", subtitle = "only showing countries with new cases (> 100)", y = "New cases per million (7 day rolling average)")
ggsave(new_cases_per_pop, filename = "new_cases_per_pop.jpg", width = 6, height = 6)
knitr::include_graphics(path="new_cases_per_pop.jpg")
ggplotly(
covid %>%
filter(location != "World") %>%
filter(location != "China") %>%
filter(new_cases_7 > 100) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, -new_cases_7_pop)) %>%
ggplot(aes(x = new_cases_7_pop, y = WoW_new_cases_7, col = continent, label = location)) +
geom_point() +
geom_text(aes(label = location), size = 2, hjust= -0.2) +
scale_y_continuous(expand = c(0,0), labels = percent_format(), breaks = seq(-1,3,0.5), limits = c(-1, 2)) +
scale_x_log10(expand = c(0.05,0.05)) +
geom_hline(yintercept = 0, linetype = "dashed") +
theme_light() +
theme(panel.grid.minor = element_blank()) +
labs(title = "New Cases growth", subtitle = "only showing countries with (> 100) new cases", y = "Week on Week change of average new cases", x = "New cases per million (log - 7 day rolling average)")
)covid %>%
filter(location != "World" & is.na(continent) == FALSE) %>%
filter(new_cases_7 > 10) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, -new_cases_7_pop)) %>%
ggplot(aes(x = new_cases_7_pop, y = WoW_new_cases_7, col = continent, label = location)) +
geom_density2d(alpha = 0.3) +
geom_point(aes(size = population)) +
#geom_text(aes(label = location), size = 2, hjust= -0.2) +
scale_y_continuous(expand = c(0,0), labels = percent_format(), breaks = seq(-1,3,0.5), limits = c(-1, 2)) +
scale_x_log10(expand = c(0.05,0.05)) +
geom_hline(yintercept = 0, linetype = "dashed") +
facet_wrap(~ continent) +
theme_light() +
theme(panel.grid.minor = element_blank()) +
labs(title = "New Cases growth by continent", subtitle = "only showing countries with (> 10) new cases", y = "Week on Week change of average new cases", x = "New cases per million (log - 7 day rolling average)", size = "population") 
just Europe - test
breaks_WoW <- c(-1, -0.5, -0.25, -0.1, 0, 0.1, 0.25, 0.5, 1, 2, Inf)
covid %>%
filter(continent == "Europe") %>%
filter(new_cases_7 > 50) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, new_cases_7_pop)) %>%
ggplot(aes(x = location, y = new_cases_7_pop, fill = WoW_new_cases_7)) +
geom_point(size = 3.5, shape = 22, col = "black") +
scale_y_continuous(expand = c(0,2)) +
# scale_color_distiller(palette = "-PiYG", values = breaks_WoW) +
scale_fill_gradientn(colours = c("green", "white", "red", "darkred"),
values = c(0, 0.33, 0.66, 1),
limits = c(-1,2),
na.value = "red") +
theme_light() +
theme(axis.title.y = element_blank(), panel.grid.minor = element_blank()) +
theme(axis.text.y = element_text(size = 7)) +
coord_flip() +
labs(title = "New cases per million", subtitle = "only showing countries with new cases (> 50)", y = "New cases per million (7 day rolling average)")
Deaths
# covid %>%
# filter(location != "World") %>%
# filter(new_deaths_7 > 5) %>%
# filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
# mutate(location = fct_reorder(location, -new_deaths_7_pop)) %>%
# ggplot(aes(x = location, y = WoW_new_deaths_7, fill = continent)) +
# geom_col(position = "dodge", col = "black") +
# scale_y_continuous(expand = c(0,0), labels = percent_format(), breaks = seq(-1,3,0.5), limits = c(-1, 2)) +
# geom_hline(yintercept = 0, linetype = "dashed") +
# theme_light() +
# theme(axis.title.x = element_blank(), panel.grid.minor = element_blank()) +
# theme(axis.text.x = element_text(angle = 90, size = 8, vjust = 0.5)) +
# labs(title = "New deaths growth", subtitle = "ordered by 7 day rolling average of new deaths (> 5) per million", y = "Week on Week change of average new deaths") new_deaths_per_pop <- covid %>%
filter(location != "World") %>%
filter(new_deaths_7 > 5) %>%
filter(new_deaths_7_pop > 0.5) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, new_deaths_7_pop)) %>%
ggplot(aes(x = location, y = new_deaths_7_pop, fill = continent)) +
geom_col(position = "dodge", col = "black") +
scale_y_continuous(expand = c(0,0)) +
geom_hline(yintercept = 0, linetype = "dashed") +
theme_light() +
theme(axis.title.y = element_blank(), panel.grid.minor = element_blank()) +
theme(axis.text.y = element_text(size = 7)) +
coord_flip() +
labs(title = "New Deaths per million", subtitle = "only showing countries with new deaths (> 5)", y = "New deaths per million (7 day rolling average)")
ggsave(new_deaths_per_pop, filename = "new_deaths_per_pop.jpg", width = 6, height = 6)
knitr::include_graphics(path="new_deaths_per_pop.jpg")
ggplotly(
covid %>%
filter(location != "World") %>%
filter(new_deaths_7 > 3) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, -new_deaths_7_pop)) %>%
ggplot(aes(x = new_deaths_7_pop, y = WoW_new_deaths_7, col = continent, label = location)) +
geom_point() +
geom_text(aes(label = location), size = 2, hjust= -0.2) +
scale_y_continuous(expand = c(0,0), labels = percent_format(), breaks = seq(-1,3,0.5), limits = c(-1, 2)) +
scale_x_log10() +
geom_hline(yintercept = 0, linetype = "dashed") +
theme_light() +
theme(panel.grid.minor = element_blank()) +
labs(title = "New deaths growth", subtitle = "only showing countries with (> 3) new deaths", y = "Week on Week change of average new deaths", x = "New deaths per million (log - 7 day rolling average)")
)#ggplotly(
covid %>%
filter(location != "World" & is.na(continent) == FALSE) %>%
filter(new_deaths_7 > 1) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, -new_deaths_7_pop)) %>%
ggplot(aes(x = new_deaths_7_pop, y = WoW_new_deaths_7, col = continent, label = location)) +
geom_point(aes(size = population)) +
geom_density2d(alpha = 0.3) +
#geom_text(aes(label = location), size = 2, hjust= -0.2) +
scale_y_continuous(expand = c(0,0), labels = percent_format(), breaks = seq(-1,3,0.5), limits = c(-1, 2)) +
scale_x_log10() +
geom_hline(yintercept = 0, linetype = "dashed") +
facet_wrap(~ continent) +
theme_light() +
theme(panel.grid.minor = element_blank()) +
labs(title = "New deaths growth by continent", subtitle = "only showing countries with (> 1) new deaths", y = "Week on Week change of average new deaths", x = "New deaths per million (log - 7 day rolling average)", size = "population") 
just Europe - test
breaks_WoW <- c(-1, -0.5, -0.25, -0.1, 0, 0.1, 0.25, 0.5, 1, 2, Inf)
covid %>%
filter(continent == "Europe") %>%
filter(new_deaths_7 > 0.5) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, new_deaths_7_pop)) %>%
ggplot(aes(x = location, y = new_deaths_7_pop, fill = WoW_new_deaths_7)) +
geom_point(size = 3.5, shape = 22, col = "black") +
scale_y_continuous(expand = c(0,0.2)) +
# scale_color_distiller(palette = "-PiYG", values = breaks_WoW) +
scale_fill_gradientn(colours = c("green", "white", "red", "darkred"),
values = c(0, 0.33, 0.66, 1),
limits = c(-1,2),
na.value = "red") +
theme_light() +
theme(axis.title.y = element_blank(), panel.grid.minor = element_blank()) +
theme(axis.text.y = element_text(size = 7)) +
coord_flip() +
labs(title = "New Deaths per million", subtitle = "only showing countries with new deaths (> 0.5)", y = "New deaths per million (7 day rolling average)")
Top 20 countries
By new cases
covid_100_n_20_3 <- covid_100 %>% filter(date == as.Date(date_today, format = "%d/%m/%Y"))
top_20_cases <- sort(covid_100_n_20_3$new_cases_7, TRUE)[21]
covid_100_n_20_2 <- covid_100_n_20_3 %>% filter(new_cases_7 > top_20_cases) %>%
mutate(top_20 = 1)
covid_100_n_20 <- covid_100_n_20_2 %>% select(location, top_20)
covid_100 %>%
ungroup() %>%
left_join(covid_100_n_20, by = "location") %>%
filter(top_20 == 1) %>%
filter(date >= as.Date(date_tests, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, -new_cases_7)) %>%
ggplot(aes(x = location, y = new_cases_7, fill = continent, group = date)) +
geom_col(position = "dodge", col = "black") +
scale_y_continuous(expand = c(0,0)) +
theme_light() +
theme(axis.title.x = element_blank()) +
theme(axis.text.x = element_text(angle = 90, size = 8, vjust = 0.5)) +
labs(title = "Average New Cases in last 3 days", subtitle = "top 20 based on 7 day rolling average", y = "New cases") 
By new deaths
covid_10_deaths_n_20_3 <- covid_10_deaths %>% filter(date == as.Date(date_today, format = "%d/%m/%Y"))
top_20_deaths <- sort(covid_10_deaths_n_20_3$new_deaths_7, TRUE)[21]
covid_10_deaths_n_20_2 <- covid_10_deaths_n_20_3 %>% filter(new_deaths_7 > top_20_deaths) %>%
mutate(top_20 = 1)
covid_10_deaths_n_20 <- covid_10_deaths_n_20_2 %>% select(location, top_20)
covid_10_deaths %>%
ungroup() %>%
left_join(covid_10_deaths_n_20, by = "location") %>%
filter(top_20 == 1) %>%
filter(date >= as.Date(date_tests, format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, -new_deaths_7)) %>%
ggplot(aes(x = location, y = new_deaths_7, fill = continent, group = date)) +
geom_col(position = "dodge", col = "black") +
scale_y_continuous(expand = c(0,0)) +
theme_light()+
theme(axis.title.x = element_blank()) +
theme(axis.text.x = element_text(angle = 90, size = 8, vjust = 0.5)) +
labs(title = "Average New Deaths in last 3 days", subtitle = "top 20 based on 7 day rolling average", y = "New deaths") 
New cases heatmap by day and country
Countries with most cases
covid_over_50k <- covid %>%
filter(date >= as.Date(date_today, format = "%d/%m/%Y")) %>%
filter(total_cases > 100000) %>%
distinct(location) %>%
mutate(include = TRUE)
scgn_cases <- scale_colour_gradientn(colours = c("#5D64C4", "#89B8D7", "#F8FAA3", "#F6B97E", "#EF8566", "#D8544F", "#B02E4E", "#570000"), values = c(0, 0.005, 0.01, 0.025, 0.05, 0.15, 0.3, 1),
limits = c(0,1500),
na.value = "grey75")
ray_cases_50k <- covid %>%
left_join(covid_over_50k, by = c("location")) %>%
filter(location != "Ecuador") %>% # remove, just temporary
filter(include == TRUE) %>%
filter(population > 5000000) %>%
filter(total_cases > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_cases)) %>%
ggplot(aes(y = location, x = date, col = new_cases_7_pop)) +
geom_point(shape = 15, size = 5) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
scgn_cases +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New Cases per million", col = "new cases per million")
ggsave(ray_cases_50k, filename = "ray_cases_50k.jpg", width = 8, height = 9)
knitr::include_graphics(path="ray_cases_50k.jpg")
Asia
ray_cases_asia <- covid %>%
filter(continent == "Asia") %>%
filter(population > 5000000) %>%
filter(total_cases > 10) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_cases)) %>%
ggplot(aes(y = location, x = date, col = new_cases_7_pop)) +
geom_point(shape = 15, size = 6) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_cases +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New Cases per million", col = "new cases per million")
ggsave(ray_cases_asia, filename = "ray_cases_asia.jpg", width = 8, height = 8)
knitr::include_graphics(path="ray_cases_asia.jpg")
Europe
ray_cases_europe <- covid %>%
filter(continent == "Europe") %>%
filter(population > 3000000) %>%
filter(total_cases > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_cases)) %>%
ggplot(aes(y = location, x = date, col = new_cases_7_pop)) +
geom_point(shape = 15, size = 6) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_cases +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New Cases per million", col = "new cases per million")
ggsave(ray_cases_europe, filename = "ray_cases_europe.jpg", width = 8, height = 6.6)
knitr::include_graphics(path="ray_cases_europe.jpg")
North America
ray_cases_NA <- covid %>%
filter(continent == "North America") %>%
filter(population > 5000000) %>%
filter(total_cases > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_cases)) %>%
ggplot(aes(y = location, x = date, col = new_cases_7_pop)) +
geom_point(shape = 15, size = 8) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_cases +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New Cases per million", col = "new cases per million")
ggsave(ray_cases_NA, filename = "ray_cases_NA.jpg", width = 8, height = 4)
knitr::include_graphics(path="ray_cases_NA.jpg")
South America
ray_cases_SA <- covid %>%
filter(continent == "South America") %>%
filter(population > 5000000) %>%
filter(total_cases > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_cases)) %>%
ggplot(aes(y = location, x = date, col = new_cases_7_pop)) +
geom_point(shape = 15, size = 8) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_cases +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New Cases per million", col = "new cases per million")
ggsave(ray_cases_SA, filename = "ray_cases_SA.jpg", width = 8, height = 3.5)
knitr::include_graphics(path="ray_cases_SA.jpg")
Africa
ray_cases_africa <- covid %>%
filter(continent == "Africa") %>%
filter(population > 5000000) %>%
filter(total_cases > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_cases)) %>%
ggplot(aes(y = location, x = date, col = new_cases_7_pop)) +
geom_point(shape = 15, size = 4) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_cases +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New Cases per million", col = "new cases per million")
ggsave(ray_cases_africa, filename = "ray_cases_africa.jpg", width = 8, height = 6.6)
knitr::include_graphics(path="ray_cases_africa.jpg")
New deaths heatmap by day and country
Countries with most deaths
covid_over_50k <- covid %>%
filter(date >= as.Date(date_today, format = "%d/%m/%Y")) %>%
filter(total_deaths > 3000) %>%
distinct(location) %>%
mutate(include = TRUE)
scgn_deaths <- scale_colour_gradientn(colours = c("#5D64C4", "#89B8D7", "#F8FAA3", "#F6B97E", "#EF8566", "#D8544F", "#B02E4E", "#570000"),
values = c(0, 0.0125, 0.025, 0.05, 0.1, 0.2, 0.4, 1),
limits = c(0, 27),
na.value = "grey75")
ray_deaths_50k <- covid %>%
left_join(covid_over_50k, by = c("location")) %>%
filter(location != "Ecuador") %>% # remove, just temporary
filter(include == TRUE) %>%
filter(population > 5000000) %>%
filter(total_deaths > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_deaths)) %>%
ggplot(aes(y = location, x = date, col = new_deaths_7_pop)) +
geom_point(shape = 15, size = 5) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
scgn_deaths +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New deaths per million", col = "new deaths per million")
ggsave(ray_deaths_50k, filename = "ray_deaths_50k.jpg", width = 8, height = 8)
knitr::include_graphics(path="ray_deaths_50k.jpg")
Asia
ray_deaths_asia <- covid %>%
filter(continent == "Asia") %>%
filter(population > 5000000) %>%
filter(total_deaths > 10) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_deaths)) %>%
ggplot(aes(y = location, x = date, col = new_deaths_7_pop)) +
geom_point(shape = 15, size = 6) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_deaths +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New deaths per million", col = "new deaths per million")
ggsave(ray_deaths_asia, filename = "ray_deaths_asia.jpg", width = 8, height = 7.5)
knitr::include_graphics(path="ray_deaths_asia.jpg")
Europe
ray_deaths_europe <- covid %>%
filter(continent == "Europe") %>%
filter(population > 3000000) %>%
filter(total_deaths > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_deaths)) %>%
ggplot(aes(y = location, x = date, col = new_deaths_7_pop)) +
geom_point(shape = 15, size = 6) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_deaths +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New deaths per million", col = "new deaths per million")
ggsave(ray_deaths_europe, filename = "ray_deaths_europe.jpg", width = 8, height = 6.6)
knitr::include_graphics(path="ray_deaths_europe.jpg")
North America
ray_deaths_NA <- covid %>%
filter(continent == "North America") %>%
filter(population > 5000000) %>%
filter(total_deaths > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_deaths)) %>%
ggplot(aes(y = location, x = date, col = new_deaths_7_pop)) +
geom_point(shape = 15, size = 8) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_deaths +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New deaths per million", col = "new deaths per million")
ggsave(ray_deaths_NA, filename = "ray_deaths_NA.jpg", width = 8, height = 4)
knitr::include_graphics(path="ray_deaths_NA.jpg")
South America
ray_deaths_SA <- covid %>%
filter(continent == "South America") %>%
filter(population > 5000000) %>%
filter(total_deaths > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_deaths)) %>%
ggplot(aes(y = location, x = date, col = new_deaths_7_pop)) +
geom_point(shape = 15, size = 8) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_deaths +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New deaths per million", col = "new deaths per million")
ggsave(ray_deaths_SA, filename = "ray_deaths_SA.jpg", width = 8, height = 3.5)
knitr::include_graphics(path="ray_deaths_SA.jpg")
Africa
ray_deaths_africa <- covid %>%
filter(continent == "Africa") %>%
filter(population > 5000000) %>%
filter(total_deaths > 1) %>%
filter(date >= as.Date("01/03/2020", format = "%d/%m/%Y")) %>%
mutate(location = fct_reorder(location, total_deaths)) %>%
ggplot(aes(y = location, x = date, col = new_deaths_7_pop)) +
geom_point(shape = 15, size = 4) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4", "#5600BB", "#6600CC" ,"#7030A0","#604A7B"),
# values = c(1.0, 0.5, 0.4, 0.3, 0.2, 0.15, 0.1, 0.05, 0.025, 0.01, 0)) +
# scale_colour_gradientn(colours = c("#B02E4E", "#D8544F", "#EF8566", "#F6B97E", "#F8FAA3", "#89B8D7", "#5D64C4"),
# values = c(1.0, 0.5, 0.3, 0.2, 0.1, 0.05, 0)) +
scgn_deaths +
theme_light() +
theme(axis.title = element_blank()) +
labs(title = "New deaths per million", col = "new deaths per million")
ggsave(ray_deaths_africa, filename = "ray_deaths_africa.jpg", width = 8, height = 6)
knitr::include_graphics(path="ray_deaths_africa.jpg")
New cases by continent
covid_100_continent %>%
ggplot(aes(x = date, y = new_cases_7, group = continent)) +
geom_line(aes(col = continent), size = 0.75) +
scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
labels = trans_format("log10", math_format(10^.x))) +
scale_x_date(expand = c(0.2,0)) +
geom_dl(aes(label = continent), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases", y = "New cases (log)", title = "New cases by continent", subtitle = "7 day rolling average") +
theme_light()
Asia
ggplotly(
covid %>%
filter(continent == "Asia") %>%
filter(date > as.Date("28/02/2020", format = "%d/%m/%Y")) %>%
filter(population > 20000000) %>%
filter(new_cases_7_pop > 1) %>%
ggplot(aes(x = date, y = round(new_cases_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases", y = "New cases per million (log)", title = "New cases 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)Europe
ggplotly(
covid %>%
filter(continent == "Europe") %>%
filter(population > 7000000) %>%
filter(new_cases_7_pop > 1) %>%
ggplot(aes(x = date, y = round(new_cases_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases", y = "New cases per million (log)", title = "New cases 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)North America
ggplotly(
covid %>%
filter(continent == "North America") %>%
filter(population > 5000000) %>%
filter(new_cases_7_pop > 1) %>%
ggplot(aes(x = date, y = round(new_cases_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases", y = "New cases per million (log)", title = "New cases 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)South America
ggplotly(
covid %>%
filter(continent == "South America") %>%
filter(population > 1500000) %>%
filter(new_cases_7_pop > 1) %>%
ggplot(aes(x = date, y = round(new_cases_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases", y = "New cases per million (log)", title = "New cases 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)Africa
ggplotly(
covid %>%
filter(continent == "Africa") %>%
filter(population > 20000000) %>%
filter(new_cases_7_pop > 1) %>%
ggplot(aes(x = date, y = round(new_cases_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases", y = "New cases per million (log)", title = "New cases 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)Oceania
ggplotly(
covid %>%
filter(continent == "Oceania") %>%
filter(population > 500000) %>%
ggplot(aes(x = date, y = round(new_cases_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases", y = "New cases per million", title = "New cases 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)New deaths by continent
covid_10_deaths_continent %>%
ggplot(aes(x = date, y = new_deaths_7, group = continent)) +
geom_line(aes(col = continent), size = 0.75) +
scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
labels = trans_format("log10", math_format(10^.x)),
expand = c(0,0)) +
scale_x_date(expand = c(0.2,0)) +
geom_dl(aes(label = continent), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 10 deaths", y = "New deaths (log)", title = "New deaths by continent", subtitle = "7 day rolling average") +
theme_light() +
theme(axis.title.x = element_blank())
Asia
ggplotly(
covid %>%
filter(continent == "Asia") %>%
filter(population > 20000000) %>%
filter(new_deaths_7_pop > 0.1) %>%
ggplot(aes(x = date, y = round(new_deaths_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(y = "New deaths per million (log)", title = "New deaths 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)Europe
ggplotly(
covid %>%
filter(continent == "Europe") %>%
filter(population > 7000000) %>%
filter(new_deaths_7_pop > 0.1) %>%
ggplot(aes(x = date, y = round(new_deaths_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(y = "New deaths per million (log)", title = "New deaths 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)North America
ggplotly(
covid %>%
filter(continent == "North America") %>%
filter(population > 5000000) %>%
filter(new_deaths_7_pop > 0.1) %>%
ggplot(aes(x = date, y = round(new_deaths_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(y = "New deaths per million (log)", title = "New deaths 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)South America
ggplotly(
covid %>%
filter(continent == "South America") %>%
filter(population > 2000000) %>%
filter(new_deaths_7_pop > 0.1) %>%
ggplot(aes(x = date, y = round(new_deaths_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(y = "New deaths per million (log)", title = "New deaths 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)Africa
ggplotly(
covid %>%
filter(continent == "Africa") %>%
filter(population > 10000000) %>%
filter(new_deaths_7_pop > 0.1) %>%
ggplot(aes(x = date, y = round(new_deaths_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_y_log10() +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(y = "New deaths per million (log)", title = "New deaths 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)Oceania
ggplotly(
covid %>%
filter(continent == "Oceania") %>%
filter(population > 500000) %>%
ggplot(aes(x = date, y = round(new_deaths_7_pop, 2))) +
geom_line(aes(col = location), size = 0.5) +
scale_x_date(limits = c(as.Date(c('28/02/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(y = "New deaths per million", title = "New deaths 7 day rolling average") +
theme_light() +
theme(legend.position = "none",
axis.title.x = element_blank())
)Cumalative Cases
by continent
covid_100_continent %>%
ggplot(aes(x = days_since_100, y = total_cases)) +
geom_line(aes(col = continent), size = 1) +
scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
labels = trans_format("log10", math_format(10^.x))) +
geom_dl(aes(label = continent), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 100 cases reported", y = "Total confirmed cases (log)", title = "Number of confirmed cases since first 100 reported") +
theme_light()
Growth rate
ggplotly(
covid_100_continent %>%
ggplot(aes(x = date, y = round(WoW_new_cases_7*100,3))) +
geom_line(aes(col = continent), size = 0.7) +
scale_x_date(limits = c(as.Date(c('01/04/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
scale_y_continuous(limits = c(-100, 300)) +
geom_dl(aes(label = continent), method = list(dl.combine("last.points"), cex = 0.6)) +
geom_hline(yintercept = 0, col = "black", linetype = "dashed", size = 0.3) +
labs(x = "Days since first 100 cases reported", y = "Week on Week change in new cases (%)", title = "Growth rate of cases (7 day rolling average)") +
theme_light() +
theme(axis.title.x = element_blank())
)Cumulative Deaths
by continent
covid_10_deaths_continent %>%
ggplot(aes(x = days_since_10, y = total_deaths)) +
geom_line(aes(col = continent), size = 1) +
scale_y_log10(breaks = trans_breaks("log10", function(x) 10^x),
labels = trans_format("log10", math_format(10^.x))) +
geom_dl(aes(label = continent), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 10 deaths", y = "Total deaths (log)", title = "Number of deaths since first 10 deaths reported") +
theme_light()
Growth rate
ggplotly(
covid_100_continent %>%
filter(continent != "Oceania") %>%
ggplot(aes(x = date, y = round(WoW_new_deaths_7*100,3))) +
geom_line(aes(col = continent), size = 0.7) +
scale_x_date(limits = c(as.Date(c('01/04/2020', date_today), format="%d/%m/%Y")), expand = c(0,3)) +
scale_y_continuous(limits = c(-100, 300)) +
geom_dl(aes(label = continent), method = list(dl.combine("last.points"), cex = 0.6)) +
geom_hline(yintercept = 0, col = "black", linetype = "dashed", size = 0.3) +
labs(x = "Days since first 100 cases reported", y = "Week on Week change in new deaths (%)", title = "Growth rate of deaths (7 day rolling average)") +
theme_light() +
theme(axis.title.x = element_blank())
)Deaths per million plotted against Italy’s trendline
covid_1_per_mil_deaths %>%
filter(location == "Czech Republic" | location == "United Kingdom" | location == "United States" | location == "Germany" | location == "China" | location == "Netherlands" | location == "Belgium" | location == "South Korea" | location == "France" | location == "Japan" | location == "Germany" | location == "Switzerland" | location == "Spain" | location == "Chile" | location == "Iran" | location == "Sweden" | location == "Brazil" | location == "Russia" | location == "Mexico" | location == "Turkey" | location == "Peru") %>%
ggplot(aes(x = days_since_1, y = total_deaths_per_million)) +
geom_line(aes(col = location), size = 1) +
# scale_y_log10() +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Days since first 1 death per million", y = "Deaths per million", title = "Deaths per million since first 1 death per million", subtitle = "Plotted against Italy's trendline") +
facet_wrap(~ location) +
geom_line(data = covid_1_per_mil_deaths_Italy, colour = "grey") +
theme_light() +
theme(legend.position = "none",
panel.grid.minor = element_blank())
Cases and deaths
Recent trend
median_new_deaths_to_cases <- covid %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
filter(location != "World" & location != "International") %>%
filter(new_cases_7 > 100 & new_deaths_7 > 0.5) %>%
select(new_deaths_to_cases, new_cases_7_pop) %>%
mutate(new_deaths_to_cases = median(new_deaths_to_cases, na.rm = TRUE),
new_cases_7_pop = median(new_cases_7_pop, na.rm = TRUE))
median_new_deaths_to_cases <- median_new_deaths_to_cases[1, ]
ggplotly(
covid %>%
filter(location != "World" & location != "International") %>%
filter(new_cases_7 > 100 & new_deaths_7 > 0.5) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(new_deaths_to_cases = new_deaths_7/new_cases_7) %>%
ggplot(aes(x = new_cases_7_pop, y = new_deaths_to_cases)) +
geom_point(aes(colour = new_deaths_to_cases, label = location)) +
scale_colour_gradient2(midpoint=median_new_deaths_to_cases$new_deaths_to_cases, low="green", high="red") +
scale_x_log10() +
scale_y_log10(label = percent_format()) +
geom_vline(xintercept = median_new_deaths_to_cases$new_cases_7_pop, linetype = "dashed", size = 0.2) +
geom_hline(yintercept = median_new_deaths_to_cases$new_deaths_to_cases, linetype = "dashed", size = 0.2) +
geom_text(aes(label = location), size = 2, hjust= -0.2) +
annotate(geom = "text", x = 400, y = 0.15, label = "don't test enough!", hjust = 0, vjust = 1, size = 3) +
annotate(geom = "text", x = 400, y = 0.0025, label = "virus present, but good testing", hjust = 0, vjust = 1, size = 3) +
annotate(geom = "text", x = 5, y = 0.0025, label = "good testing, low virus presence", hjust = 0, vjust = 1, size = 3) +
annotate(geom = "text", x = 4, y = 0.15, label = "low testing, but okay?", hjust = 0, vjust = 1, size = 3) +
theme_dark() +
labs(title = "New deaths to cases ratio", x = "New cases per million (log)", y = "New deaths to cases ratio (log)", colour = "New deaths
to cases")
)median_new_deaths_to_cases <- covid %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
filter(location != "World" & location != "International") %>%
filter(new_cases_7 > 100 & new_deaths_7 > 0.5) %>%
select(new_deaths_to_cases) %>%
mutate(new_deaths_to_cases = median(new_deaths_to_cases, na.rm = TRUE))
median_new_deaths_to_cases <- median_new_deaths_to_cases[1, 1]
ggplotly(
covid %>%
filter(location != "World" & location != "International") %>%
filter(new_cases_7 > 100 & new_deaths_7 > 0.5) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(new_deaths_to_cases = new_deaths_7/new_cases_7) %>%
ggplot(aes(x = new_cases_7_pop, y = new_deaths_7_pop)) +
geom_point(aes(colour = new_deaths_to_cases, label = location)) +
scale_colour_gradient2(midpoint=median_new_deaths_to_cases$new_deaths_to_cases, low="green", high="red") +
scale_x_log10() +
scale_y_log10() +
geom_smooth(method = "lm", se = FALSE, linetype = "dashed", size = 0.5) +
geom_text(aes(label = location), size = 2, hjust= -0.2) +
theme_dark() +
labs(title = "New Deaths and Cases", x = "New cases per million (log)", y = "New deaths per million (log)", colour = "New deaths
to cases")
)Cumulative Scatter plot
median_case_fatality <- covid %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
filter(location != "World" & location != "International") %>%
filter(total_cases > 10000 & total_deaths > 100) %>%
select(case_fatality) %>%
mutate(case_fatality = median(case_fatality, na.rm = TRUE))
median_case_fatality <- median_case_fatality[1, 1]
ggplotly(
covid %>%
filter(location != "World" & location != "International" & location != "China") %>%
filter(total_cases > 10000 & total_deaths > 100) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(case_fatality = total_deaths/total_cases) %>%
ggplot(aes(x = total_cases_per_million, y = total_deaths_per_million)) +
geom_point(aes(colour = case_fatality, label = location)) +
scale_colour_gradient2(midpoint=median_case_fatality$case_fatality, low="green", high="red") +
scale_x_log10() +
scale_y_log10() +
geom_smooth(method = "lm", se = FALSE, linetype = "dashed", size = 0.5) +
geom_text(aes(label = location), size = 2, hjust= -0.2) +
theme_dark() +
labs(title = "Deaths and Cases", subtitle = "countries with at least 1000 cases and 50 deaths", x = "Total cases per million (log)", y = "Total deaths per million (log)")
)Case Fatality rates
covid %>%
filter(location != "World" & location != "International") %>%
filter(total_cases > 60000 & total_deaths > 300) %>%
filter(date == as.Date(date_today, format = "%d/%m/%Y")) %>%
mutate(case_fatality = total_deaths/total_cases,
location = fct_reorder(location, -case_fatality)) %>%
ggplot(aes(x = location, y = case_fatality, fill = continent)) +
geom_col() +
scale_y_continuous(expand = c(0, 0), labels = percent_format()) +
theme_light() +
theme(axis.title.x = element_blank(), panel.grid.minor = element_blank()) +
theme(axis.text.x = element_text(angle = 90, size = 8, vjust = 0.5)) +
labs(title = "Case Fatality rates of countries with at least 10000 cases and 300 deaths", y = "Case Fatality rates") 
ggplotly(
covid %>%
filter(total_cases > 1000 & total_deaths > 50) %>%
filter(date == as.Date(date_tests, format = "%d/%m/%Y")) %>%
mutate(case_fatality = total_deaths/total_cases) %>%
ggplot(aes(x = total_cases/total_tests, y = case_fatality)) +
geom_point(aes(colour = case_fatality, label = location)) +
scale_colour_gradient2(midpoint=median_case_fatality$case_fatality, low="green", high="red") +
scale_x_log10(labels = percent_format()) +
scale_y_log10(labels = percent_format()) +
geom_smooth(method = "lm", se = FALSE, linetype = "dashed", size = 0.5) +
geom_text(aes(label = location), size = 2, hjust= -0.2) +
theme_dark() +
labs(title = "CFR by % of positive tests", subtitle = "countries with at least 1000 cases and 50 deaths", x = "% of positive tests", y = "Case Fatality Ratio")
)Tests per thousand
Some missing test data
covid %>%
filter(location != "World" & location != "International") %>%
filter(total_cases > 1000 & total_deaths > 40 & total_tests_per_thousand > 1) %>%
filter(date == as.Date(date_tests, format = "%d/%m/%Y")) %>%
mutate(case_fatality = total_deaths/total_cases,
location = fct_reorder(location, -total_tests_per_thousand)) %>%
ggplot(aes(x = location, y = total_tests_per_thousand, fill = continent)) +
geom_col() +
scale_y_continuous(expand = c(0, 0)) +
theme_light() +
theme(axis.title.x = element_blank()) +
theme(axis.text.x = element_text(angle = 90, size = 8, vjust = 0.5)) +
labs(title = "Tests per thousand", subtitle = "countries with available data", y = "Tests per thousand") 
covid %>%
filter(location != "World" & location != "International") %>%
filter(total_cases > 1000 & total_deaths > 40 & new_tests_per_thousand > 0.2) %>%
filter(date == as.Date(date_tests, format = "%d/%m/%Y")) %>%
mutate(case_fatality = total_deaths/total_cases,
location = fct_reorder(location, -new_tests_per_thousand)) %>%
ggplot(aes(x = location, y = new_tests_per_thousand, fill = continent)) +
geom_col() +
scale_y_continuous(expand = c(0, 0)) +
theme_light() +
theme(axis.title.x = element_blank()) +
theme(axis.text.x = element_text(angle = 90, size = 8, vjust = 0.5)) +
labs(title = "Tests per thousand", subtitle = "countries with available data", y = "New tests per thousand") 
covid %>%
filter(total_deaths > 10) %>%
filter(location == "Czech Republic" | location == "Italy" | location == "United Kingdom" | location == "United States" | location == "Germany" | location == "China" | location == "Netherlands" | location == "Belgium" | location == "South Korea" | location == "France" | location == "Japan" | location == "Germany" | location == "Switzerland" | location == "Spain" | location == "Norway" | location == "Austria" | location == "Australia"| location == "Brazil" | location == "Russia" | location == "Mexico") %>%
ggplot(aes(x = date, y = case_fatality)) +
geom_line(aes(col = location), size = 1) +
scale_y_continuous(labels = percent_format()) +
scale_x_date(expand = c(0,20)) +
geom_dl(aes(label = location), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Date", y = "Case Fatality rate", title = "Case Fatality rate since first 10 deaths") +
theme_light() +
theme(legend.position = "none")
covid_100_continent %>%
mutate(total_deaths/total_cases) %>%
ggplot(aes(x = date, y = case_fatality)) +
geom_line(aes(col = continent), size = 1) +
scale_y_continuous(labels = percent_format()) +
scale_x_date(expand = c(0,20)) +
geom_dl(aes(label = continent), method = list(dl.combine("last.points"), cex = 0.6)) +
labs(x = "Date", y = "Case Fatality rate", title = "Case Fatality rate since first 10 deaths") +
theme_light()